The World of Computer Software/The World of Computer Software.iso/eue10.zip/REGISTER.PRG

Text File | 1992-12-29 | 12KB | 432 lines

*Extended User Editor (register) - version 1.0 12/30/92 (c) 1992 James E. Swarm
*
*This version of the program is fully working, and is to be considered
*shareware.  If you use this software I ask that you register it with
*a donation to my BBS.  Registered users will receive full tdbs source
*(available for download) for both the USERLIST and USEREDIT program.
*A donation is $20.00 or higher... thats up to you, but the better
*responce I get, the more I will update the programs.
*
*Please send all donations to:
*
*James E. Swarm
*
*P.O. Box 361093
*Strongsville, Ohio 44136
*BBS [phone]
*
* WARRNING THIS CODE CHANGES USERFLAGS A1 1,2,3 and 8!!!
*
SET EXCLUSIVE OFF
SET ESCAPE OFF
public elite,age,recomend,comp,baud,add1,add2,city,state,zip,country,phone,location,realn,user
public f_add1,f_add2,f_city,f_state,f_zip,f_country,f_phone,f_location,f_realn,f_user,f_newubyte,f_newdbyte
public f_age,f_callmday,f_mday,f_ratiou,f_ratiod,f_timebank,f_modify
public sname,answer,handle,cnumber,counter
clear
name = ""
? ""
? "Please answer the following registration questions."
? ""
do prname
do pphone
do padd1
do padd2
do pcity
do pstate
do pzip
do pcountry
do pbday
do pcomputer
do precomend
do pfiles
do display
DO WHILE .T.
        DO getanser WITH "YN",.T.,"N"
        DO CASE
        CASE answer = "Y"
                userinfo = (((((((((((((add1+chr(0))+add2)+chr(0))+city)+chr(0))+state)+chr(0))+zip)+chr(0))+phone)+chr(0))+country)+chr(0))
                pokedummy = ulpoke(256,6,userinfo,128)
                use "useredit"
                set index to "username"
                name = uname()
                seek name
                if .not. found()
                        append blank
                endif
                replace f_user with uname()
                replace f_realn with realn
                dummy=ulreplace(unotes,realn)
                replace f_location with ulocation()
                replace f_phone with phone
                replace f_add1 with add1
                replace f_add2 with add2
                replace f_city with city
                replace f_state with state
                replace f_zip with zip
                replace f_country with country
                replace f_age with age
                replace f_comp with comp
                replace f_recomend with recomend
                replace f_elite with elite
                replace f_newubyte with 0
                replace f_newdbyte with 0
                replace f_modify with .F.
                replace f_ratiou with 1
                replace f_ratiod with 1
                use
                a1 = uauth(1)
                a1_off = stuff(a1,1,1,".")
                set = ULREPLACE(UAUTH,1,a1_off)
                exit
        CASE answer = "N"
                do edisplay
                DO WHILE .T.
                        DO getanser WITH "ABCDEFGHIJK",.T.,"Q"
                        ? ""
                        DO CASE
                        CASE answer = "A"
                                do prname
                                do edisplay
                                loop
                        CASE answer = "B"
                                do pphone
                                do edisplay
                                loop
                        CASE answer = "C"
                                do padd1
                                do padd2
                                do edisplay
                                loop
                        CASE answer = "D"
                                do pcity
                                do edisplay
                                loop
                        CASE answer = "E"
                                do pstate
                                do edisplay
                                loop
                        CASE answer = "F"
                                do pzip
                                do edisplay
                                loop
                        CASE answer = "G"
                                do pcountry
                                do edisplay
                                loop
                        CASE answer = "H"
                                do pbday
                                do edisplay
                                loop
                        CASE answer = "I"
                                do pcomputer
                                do edisplay
                                loop
                        CASE answer = "J"
                                do precomend
                                do edisplay
                                loop
                        CASE answer = "K"
                                do pfiles
                                do edisplay
                                loop
                        CASE answer = "Q"
                                do display
                                exit
                        ENDCASE
                ENDDO
        ENDCASE
ENDDO
dotbbs type 1 optdata "notice.txt/nk"
? ""
? "Do you AGREE to all the above infromation (Y/n)? "
DO WHILE .T.
        DO getanser WITH "YN",.T.,"Y"
        DO CASE
        CASE answer = "Y"
                a1 = uauth(1)
                a1_off = stuff(a1,2,1,".")
                set = ULREPLACE(UAUTH,1,a1_off)
                exit
        CASE answer = "N"
                exit
        ENDCASE
ENDDO
dotbbs type 1 optdata "yesno.txt/nk"
? ""
? "Please answer YES or NO (y/N)? "
DO WHILE .T.
        DO getanser WITH "YN",.T.,"N"
        DO CASE
        CASE answer = "Y"
                exit
        CASE answer = "N"
                a1 = uauth(1)
                a1_off = stuff(a1,3,1,".")
                set = ULREPLACE(UAUTH,1,a1_off)
                exit
        ENDCASE
ENDDO
quit

PROCEDURE getanser

PARAMETER srchstrng, default, def_val

DO WHILE .T.
   key = INKEY(0)
   IF key = 13 .AND. default
      answer = def_val
      ?? answer
      EXIT
   ENDIF
   answer = UPPER(CHR(key))
   IF .NOT. answer $ srchstrng
      LOOP
   ENDIF
   ?? answer
   EXIT
ENDDO
RETURN

PROCEDURE display

clear
? "Please verify the following information."
? ""
? "Name        : " uname()
? "From        : " ulocation()
? "Real Name   : " realn
? "Phone       : " phone
? "Address     : " add1
? "            : " add2
? "City        : " city
? "State       : " state
? "Zip         : " zip
? "Country     : " country
? "Age         : " age
? "C.Type      : " comp
? "Recomend    : " recomend
? "Files       : " elite
? ""
? "Is this information correct (y/N)? "
return

PROCEDURE edisplay

clear
? "Please verify the following information."
? ""
? "Name        : " uname()
? "From        : " ulocation()
? "Real Name(A): " realn
? "Phone    (B): " phone
? "Address  (C): " add1
? "            : " add2
? "City     (D): " city
? "State    (E): " state
? "Zip      (F): " zip
? "Country  (G): " country
? "Age      (H): " age
? "C.Type   (I): " comp
? "Recomend (J): " recomend
? "Files    (K): " elite
? ""
? "Please enter the letter of the line to edit (ENTER to exit). "
? ": "
return


PROCEDURE replace

replace f_user with user
replace f_realn with realn
replace f_location with location
replace f_phone with phone
replace f_add1 with add1
replace f_add2 with add2
replace f_city with city
replace f_state with state
replace f_zip with zip
replace f_country with country
return

PROCEDURE prname
do while .t.
        ? "What is your FULL real name?"
        accept ": " to realn
        ? ""
        lenght = len(realn)
        if lenght < 3
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        realn = left(realn,30)
        exit
enddo
return
PROCEDURE pphone
do while .t.
        ? "What is your VOICE phone number (XXX-XXX-XXXX)?"
        accept ": " to phone
        ? ""
        length = len(phone)
        if length < 12 .or. length > 12
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        phone = left(phone,12)
        exit
enddo
return
PROCEDURE padd1
do while .t.
        ? "What is your address (Street Address Only, you have two lines)?"
        accept ": " to add1
        lenght = len(add1)
        if lenght < 2
                ? ""
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        add1 = left(add1,31)
        exit
enddo
return
PROCEDURE padd2
do while .t.
        accept ": " to add2
        ? ""
        add2 = left(add2,31)
        exit
enddo
return
PROCEDURE pcity
do while .t.
        ? "What City/Province do you live in?"
        accept ": " to  city
        ? ""
        lenght = len(city)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        city = left(city,20)
        exit
enddo
return
PROCEDURE pstate
do while .t.
        ? "What State do you live inn (2 letter)?"
        accept ": " to state
        ? ""
        lenght = len(state)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        state = left(state,2)
        if .not. isstate(state)
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        exit
enddo
return
PROCEDURE pzip
do while .t.
        ? "What is your Zip/Postal Code?"
        accept ": " to zip
        ? ""
        lenght = len(zip)
        if lenght < 5
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        zip = left(zip,10)
        exit
enddo
return
PROCEDURE pcountry
do while .t.
        ? "What Country do you live in (USA, CANADA etc.)?"
        accept ": " to country
        ? ""
        lenght = len(country)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        country = left(country,10)
        exit
enddo
return
PROCEDURE pbday
do while .t.
        ? "What is your birth date (MM/DD/YY)?"
        accept ": " to age
        ? ""
        lenght = len(age)
        if lenght < 8 .or. lenght > 8
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        age = ctod(age)
        exit
enddo
return
PROCEDURE pcomputer
do while .t.
        ? "What type of computer do you have (ex. 386SX, Atari ST)?"
        accept ": " to comp
        ? ""
        lenght = len(comp)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        comp = left(comp,20)
        exit
enddo
return
PROCEDURE precomend
do while .t.
        ? "Who Recomended you to this system?"
        accept ": " to recomend
        ? ""
        lenght = len(recomend)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        recomend = left(recomend,30)
        exit
enddo
return
PROCEDURE pfiles
do while .t.
        ? "What are your latest files?"
        accept ": " to elite
        ? ""
        lenght = len(elite)
        if lenght < 2
                ? "Invalid data, please re-enter."
                ? ""
                loop
        endif
        elite = left(elite,30)
        exit
enddo
return